home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_1 / pubdom.tar / pubdom / rbj / seg2 < prev    next >
Text File  |  1990-05-05  |  5KB  |  119 lines
  1. %%HP: T(3)A(D)F(.);
  2. @ SEG Program - Segment of a circle.  
  3. @   Given any 2 of the 5 dimensions, solve for all of the others
  4. @   SEG is actually a directory with several functions and 
  5. @       variables.  This creates the various objects in a sequence
  6. @       that makes the VAR menu do the job.
  7. @   RBJ 3/22/90 Initial efforts
  8. @       3/23/90 Case logic for function execution, empty stack logic
  9. @       3/24/90 Finish iterative cases, use Flag 6
  10. @       5/05/90 Shortened variable names, inline code, decimal code
  11. @               Print if flag 9 is set (Highest 2.5 byte flag)
  12. DIR
  13.   Arc    \<< 'Ar' "Arc"   16 iF \>>
  14.   Rise   \<< 'Ri' "Rise"   8 iF \>>
  15.   Chord  \<< 'Ch' "Chord"  4 iF \>>
  16.   Radiu  \<< 'Ra' "Radius" 2 iF \>>
  17.   Angl   \<< 'An' "Angle"  1 iF \>>
  18.   Disp   \<< 
  19.     iC CASE
  20.       DUP 24 == THEN ArRi END
  21.       DUP 20 == THEN ArCh END
  22.       DUP 18 == THEN ArRa END
  23.       DUP 17 == THEN ArAn END
  24.       DUP 12 == THEN RiCh END
  25.       DUP 10 == THEN RiRa END
  26.       DUP  9 == THEN RiAn END
  27.       DUP  6 == THEN ChRa END
  28.       DUP  5 == THEN ChAn END
  29.       DUP  3 == THEN RaAn END
  30.     END
  31.     CLLCD                                   @ Clear Screen
  32.     IF                                      @ Test iC code left on stack
  33.       THEN "New" ELSE "Prev"
  34.     END  
  35.     " Results" +
  36.     IF 9 FS? THEN CR PR1 END                @ Print control on FLAG 9
  37.     1 DISP
  38.     2 Ar "Arc"    rD
  39.     3 Ri "Rise"   rD
  40.     4 Ch "Chord"  rD
  41.     5 Ra "Radius" rD
  42.     6 An "Angle"  rD
  43.     3 FREEZE 
  44.     0 'iC' STO 6 CF
  45.   \>>
  46.  
  47.   Ar 0  Ri 0  Ch 0  An 0  Ra 0              @ Main variables
  48.   fW 12                                     @ Numeric Field Width
  49.   iC 0                                      @ Current sum of input flags
  50.  
  51.   iF  \<<                                   @ Common Input function
  52.     \-> var lab code \<<                    @ Create local variables
  53.       IF DEPTH 0 == THEN var RCL END        @ If nothing on stack use prev
  54.       DUP var STO                           @ Store
  55.       lab ": " + SWAP + "\010" +            @ "Tagged" display on line 1
  56.       1 DISP 1 FREEZE 
  57.       code 'iC' STO+                        @ Add Input flag code
  58.       IF 6 FS?C                             @ Flag 6 flags 1st data item IN
  59.         THEN Disp ELSE 6 SF                 @ If set, Clear and solve    
  60.       END 
  61.     \>>             
  62.   \>>
  63.  
  64.   rD \<<                                    @ line value label -> [display]
  65.     SWAP fW                                 @ value fieldWidth for right just
  66.     SWAP \->STR DUP SIZE                    @ Convert value to string, get len
  67.     ROT - NEG                               @ Number of blanks to prepend
  68.     "            " 1 ROT SUB                @ Get Blanks
  69.     SWAP + " " + SWAP +                     @ Pad, Add Label
  70.     IF 9 FS? THEN PR1 END                   @ Print control on FLAG 9
  71.     SWAP DISP \>>                           @ Display on specified line
  72.  
  73.   @ *** Actual Computation Routines ***
  74.  
  75.   Iter \<<
  76.    'Ra' Ar ROOT                           @ Find Ra (guess = Ar  )
  77.    'Ra' STO DEG ArRa \>>
  78.  
  79.   ArRi \<< RAD                              @ Arc / Rise (Solver for Ra)
  80.     \<< Ar Ra / 2 /                         @ Angle given arc, trial rad
  81.         COS NEG 1 + Ra * Ri - \>>           @ computed - actual rise
  82.     Iter \>>                                @ Solve for Ra, etc
  83.   ArCh \<< RAD                              @ Arc / Chord (Solver for Ra)
  84.     \<< Ar Ra / 2 /                         @ Angle given arc, trial rad
  85.         SIN Ra * 2 * Ch - \>>               @ Computed - Actual chord
  86.     Iter \>>                                @ Solve for Ra, etc
  87.   ArRa \<<                                  @ Arc / Radius
  88.     Ar Ra / R\->D 'An' STO                  @ Compute Angle
  89.     RaAn \>>
  90.   ArAn \<<                                  @ Arc / Angle
  91.     Ar An D\->R / 'Ra' STO                  @ Compute radius
  92.     RaAn \>>
  93.  
  94.   RiCh \<<                                  @ Rise / Chord (see AISC)
  95.     4 Ri SQ * Ch SQ + 8 Ri * /              @ Find radius
  96.     'Ra' STO ChRa \>>
  97.   RiRa \<<                                  @ Given Radius, Rise
  98.     Ra Ri - Ra / ACOS 2 * 'An' STO          @ Compute Angle
  99.     RaAn \>>
  100.   RiAn \<<                                  @ Rise / Angle
  101.     Ri An 2 / COS NEG 1 + / 'Ra' STO        @ Compute radius
  102.     RaAn \>>
  103.  
  104.   ChRa \<<                                  @ Chord / Radius
  105.     Ch 2 / Ra / ASIN 2 * 'An' STO           @ Compute angle
  106.     RaAn \>>
  107.   ChAn \<<                                  @ Chord / Angle
  108.     Ch 2 / An 2 / SIN / 'Ra' STO            @ Compute radius
  109.     RaAn \>>
  110.  
  111.                                             @ MAIN COMPUTE FUNCTION
  112.   RaAn \<<                                  @ Radius / Angle
  113.     An D\->R Ra * 'Ar' STO                  @ Compute Arc Length
  114.     An 2 / DUP SIN Ra * 2 * 'Ch' STO        @ Compute Chord
  115.     COS NEG 1 + Ra * 'Ri' STO  \>>          @ Compute Rise
  116.  
  117. END
  118.  
  119.